VBA学习笔记本(二)

2023-12-28 12:41| 来源: 网络整理| 查看: 265

最近遇到很多要在两个表之间同步数据的情况，比如在sheet1 为基础表表中有非常多的字段

姓名学号班级专业性别年龄籍贯张A001一班计算机男15北京王B002一班物理男30上海张C003一班采矿男18北京李E004一班软件男20北京秦F005一班财会男26北京

而在Sheet2中却只有如下数据

姓名学号班级专业性别年龄籍贯张A001张C003李E004秦F005

Sheet2中的信息不全，需要补充完整，所以就需要VBA进行快速匹配，但是如果为了通用性，不仅仅局限于这个两张表中，就增加了一些功能。首先建立一个窗体增加如下控件：在这里插入图片描述三个下拉框分别为选取需要匹配的工作表，也就是本立中的Sheet2，另一个作为基准表，也就是本利中的Sheet1，二基准字段为两个表中匹配时作为关联的一个字段，本利中未学号，需要为唯一值。

新建一个模块，用于存放基础方法，共需建立一个窗口一个模块在这里插入图片描述

基础功能模块中算法如下：

Function 获取表头数组(表名) '''本方法作用是输入表名，返回对应表中首行表头组成的数组 '''使用了字典的作用是为了去重 '关闭页面刷新 Application.ScreenUpdating = False Sheets(表名).Select With Sheets(表名) 表行数 = Sheets(表名).UsedRange.Rows.Count 表列数 = Sheets(表名).UsedRange.Columns.Count 表头数组 = Sheets(表名).Range(Cells(1, 1), Cells(1, 表列数)).Value Dim 表头字典 As Object '声明字典对象，亦可通过声明变体型变量完成声明 >>> Dim d Set 表头字典 = CreateObject("Scripting.Dictionary") '声明字典 For i = 1 To 表列数表头字典(Sheets(表名).Cells(1, i) & "") = i Next i Dim 表数组() 表数组 = Sheets(表名).Range(Cells(1, 1), Cells(表行数, 表列数)).Value 表数组行数 = UBound(表数组) - LBound(表数组) + 1 End With '通过字典转化后可以实现去除的目的表头数组 = 表头字典.Keys Application.ScreenUpdating = True 获取表头数组 = 表头数组 End Function Function 同步表内容(需同步表, 基准表, 基准字段) '''本方法作用为同步两个表的数据，需输入需同步表，基准表，基准字段三个参数 '关闭页面刷新 Application.ScreenUpdating = False '加上选中工作表，可以减少一些不必要的错误，比如在数组赋值的时候如果不是选中工作表中就会报错 Sheets(需同步表).Select '用with可以减少引用，方便书写，也可以小幅度的提高速度 With Sheets(需同步表) '获取表中有数据的行数和列数需同步表行数 = .UsedRange.Rows.Count 需同步表列数 = .UsedRange.Columns.Count '将需同步表的表头放入数组需同步表头数组 = .Range(Cells(1, 1), Cells(1, 需同步表列数)).Value '将表头内容存入字典 Dim 需同步表头字典 As Object '声明字典对象，亦可通过声明变体型变量完成声明 >>> Dim d Set 需同步表头字典 = CreateObject("Scripting.Dictionary") '声明字典 For i = 1 To 需同步表列数需同步表头字典(Sheets(需同步表).Cells(1, i) & "") = i Next i '将需同步表内数据放入数组 Dim 需同步表数组() 需同步表数组 = .Range(Cells(1, 1), Cells(需同步表行数, 需同步表列数)).Value 需同步表数组行数 = UBound(需同步表数组) - LBound(需同步表数组) + 1 End With Sheets(基准表).Select With Sheets(基准表) 基准表行数 = Sheets(基准表).UsedRange.Rows.Count 基准表列数 = Sheets(基准表).UsedRange.Columns.Count 基准表头数组 = Sheets(基准表).Range(Cells(1, 1), Cells(1, 基准表列数)).Value Dim 基准表头字典 As Object '声明字典对象，亦可通过声明变体型变量完成声明 >>> Dim d Set 基准表头字典 = CreateObject("Scripting.Dictionary") '声明字典 For i = 1 To 基准表列数基准表头字典(Sheets(基准表).Cells(1, i) & "") = i Next i Dim 基准表数组() 基准表数组 = Sheets(基准表).Range(Cells(1, 1), Cells(基准表行数, 基准表列数)).Value 基准表数组行数 = UBound(基准表数组) - LBound(基准表数组) + 1 End With '将需同步表头的内容字典的所有key，放入数组中需同步表头字典keys = 需同步表头字典.Keys '通过循环来判断是否相等及赋值 For i = 2 To 需同步表数组行数 For j = 2 To 基准表数组行数 If 需同步表数组(i, 需同步表头字典(基准字段)) = 基准表数组(j, 基准表头字典(基准字段)) Then '通过循环，为每一行的每个单元格进行赋值 For m = 0 To UBound(需同步表头字典keys) - 1 If 基准表头字典.exists(需同步表头字典keys(m)) Then 'exists是用来判断字典中是否存在某个kye，用此方法比循环效率更高 Sheets(需同步表).Cells(i, 需同步表头字典(需同步表头字典keys(m))) = 基准表数组(j, 基准表头字典(需同步表头字典keys(m))) End If Next m End If Next j Next i Sheets(需同步表).Select '打开屏幕刷新输出结果 Application.ScreenUpdating = True '返回函数值同步表内容 = "数据同步处理完成!" End Function

读取表名按钮方法：

Private Sub 读取表名按钮_Click() '''读取当前工作簿中所有的工作表，并且赋值给对应的下拉框控件 '重置下拉框内容 ComboBox_需匹配表.Clear ComboBox_基准表.Clear '通过循环，获取工作表序号，然后将其名字放入下拉框控件中 For i = 1 To Sheets.Count '在下拉框控件中加入内容 ComboBox_需匹配表.AddItem (Sheets(i).Name) ComboBox_基准表.AddItem (Sheets(i).Name) Next i End Sub

在需求匹配表内容选择后，基准字段下拉框中添加对应表头信息

'下拉框变化事件，当某下拉框内容变化后触发此事件 Private Sub ComboBox_需匹配表_change() 表头数组 = 基础功能模块.获取表头数组(ComboBox_需匹配表.Text) 'Debug.Print (ComboBox_需匹配表.Text & "_" & 表头数组(0)) 表头数组长度 = UBound(表头数组) - LBound(表头数组) For i = 0 To 表头数组长度 '在下拉框控件中加入内容 ComboBox_基准字段.AddItem (表头数组(i)) Next i End Sub

匹配内容按钮主要功能是调用函数进行计算

Private Sub 匹配内容按钮_Click() 需同步表名 = ComboBox_需匹配表.Text 基准表名 = ComboBox_基准表.Text 基准字段 = ComboBox_基准字段.Text 返回信息 = 基础功能模块.同步表内容(需同步表名, 基准表名, 基准字段) MsgBox (返回信息) End Sub

综上以上即可实现通用的数据匹配，但是前提是两个工作表的表头字段是一样的，表头顺序无所谓，但是名称一定一样。

示例文件：https://download.csdn.net/download/huaqitaishao/12325721

【本文地址】

公司简介

联系我们